home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / alph100p.zip / DEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1991-11-02  |  16KB  |  456 lines
  1. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X-}
  2. {$M 1024,0,0}
  3. program AlphaDemo;
  4.  
  5. uses
  6.   wow,
  7.   ALPHA;
  8.  
  9. Var
  10.   N, XX: byte;
  11.  
  12.  
  13. procedure PrimaryFileExit; Far;
  14. begin
  15. {-vvvv PUT YOUR VERY LAST SCREEN DISPLAY & CODE HERE vvvvvvv-}
  16.  
  17.   writeln;
  18.   Writeln;
  19.   Writeln('   PARTING COMMENTS:');
  20.   Writeln;
  21.   Writeln('   ALPHA automatically keeps track  of your programs starting DOS environment.');
  22.   Writeln('   It  can  automatically restore  these values  when your  program terminates');
  23.   Writeln('   with  ALPHA''s Exit Procedure.   In addition,  ALPHA can provide for an exit');
  24.   Writeln('   Procedure for your main program, too.');
  25.   Writeln;
  26.   Writeln('   Both of these features are optional and need to be requested by you, in the');
  27.   Writeln('   StartUp procedure.');
  28.   Writeln;
  29.   Writeln('   Since a mode change will result in a total loss of  all displayed messages,');
  30.   Writeln('   any parting comments to your  users must be made in this  Main Program Exit');
  31.   Writeln('   Procedure. Be sure, to keep it simple and leave out color.');
  32.   Writeln;
  33.   writeln('   Study this DEMO program for actual programming examples.');
  34.  
  35. {-^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^-}
  36. (*  Halt(ExitCode); { Your PC will lock up without this line! } *)
  37. end;
  38.  
  39. procedure StartUp;
  40. begin
  41.   LastProc:=@PrimaryFileExit;         { if you want ALPHA to Add a Main Exit Procedure }
  42.   MakeAlphaChoice(Cga16_Mode);        { Informs ALPHA that you want 16 background colors on a CGA }
  43. {----------------------------------------------------}
  44.  
  45.   randomize;
  46.  
  47.   TextMode(CO40);
  48.   Prepare8Page(first,off,white,blue8);
  49.   pause(1);
  50.   gotoxy(1,10);
  51.   EchoLn('             THE ALPHA DEMO');
  52.   echoln('');
  53.   echoln('              version 1.00');
  54.   pause(4);
  55.   TextMode(CO80);
  56.   cursor(off);      { cursor needs to be reset after textmode change }
  57.   cls;            { paints screen blue }
  58.   gotoxy(1,10);
  59.   echoln('           Copyright (C) 1991, John H. Gohde, All rights reserved');
  60.   pause(3);
  61.  
  62.   cls;
  63.   gotoxy(1,10);
  64.   EchoLn('    NOTE:  This DEMO  will demonstrate  VGA,  EGA,  and  CGA features.');
  65.   EchoLn('    Yet, due to the clever programming of the  ALPHA unit this program');
  66.   EchoLn('    will run as is,  without any changes on: MONO, CGA, EGA, VGA, PGA,');
  67.   EchoLn('    and MCGA monitors.');
  68.   echoln('');
  69.   EchoLn('    You  too can  write  ONE program  that will work with  one set  of');
  70.   EchoLn('    instructions that will run on ALL available monitors with ALPHA!!!');
  71.   pause(15);
  72.  
  73.   cls;                 { you can not see writeln when it is re-directed }
  74.   gotoxy(1,10);
  75.   WriteLn('         Here is some of the info that ALPHA knows:');
  76.   WriteLn('');
  77.   WriteLn('                 Video Adapter=',VideoAdapter2Str(VideoAdapter):10);
  78.   WriteLn('                 Text Mode=',LastMode:14);
  79.   WriteLn('                 Foreground=',Color2Str(GetForeground(TextAttr)):13);
  80.   WriteLn('                 Background=',Color2Str(GetBackground(TextAttr)):13);
  81.   WriteLn('                 Number of Rows=',MaxRows:9);
  82.   WriteLn('                 Number of Columns=',MaxCols:6);
  83.   WriteLn('                 Current Page=',Pages2Str(LastPage):11);
  84.   WriteLn('                 Active Page=',Pages2Str(getactivepage):12);
  85.   pause(15);
  86.  
  87. {----------------------------------------------------}
  88. end;
  89.  
  90.  
  91.  
  92. Procedure CursorDemo;
  93. begin
  94.   PreparePage(First ,ON ,white,green);
  95.   writeln;
  96.   writeln('  ...demonstrating ALPHA''s new CURSOR features:');
  97.  
  98.   gotoxy(05,5);write('NOTE note how APLHA can set the cursor to a block format.');
  99.   CURSOR(BLOCK);pause(3);
  100.  
  101.   GotoXY(05,5);ClrEol;GotoXY(05,5);cursor(off);
  102.   write('NOTE note how APLHA can turn the cursor off.');pause(3);
  103.  
  104.   GotoXY(05,5);ClrEol;GotoXY(05,5);
  105.   write('NOTE how APLHA can reverse colors.');pause(2);
  106.   reversecolorXY(5,5,34);pause(3);
  107.  
  108.   GotoXY(05,5);ClrEol;GotoXY(05,5);
  109.   write('NOTE how APLHA can change colors.');pause(2);
  110.   ChangeColorXY(5,5,33,black,red);pause(5);
  111. end;
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118. Procedure CrtFeatures;
  119.   Procedure Reset;
  120.   begin
  121.     XX:=TextAttr;
  122.     Cls;gotoxy(10,2);TextColor(White);
  123.     writeln('...demonstrating ALPHA''s standard CRT unit features:');
  124.     TextAttr:=XX;
  125.   end;
  126.  
  127.   Procedure TextModeDemo(N: WORD);
  128.   Const
  129.    Mode: array [0..5] of str7 = ('BW40','CO40','BW80','CO80','MONO','FONT8X8');
  130.   begin
  131.     TextMode(N);
  132.     Case N of
  133.         7: N:=4;
  134.       256: N:=5;
  135.     end;
  136.     writeln;writeln;
  137.     writeln('...demonstrating ALPHA''s standard CRT unit features:');
  138.     writeln;writeln;
  139.     writeln('   The TEXTMODE statement is used to change your video modes.');
  140.     WRITELN;writeln;
  141.     writeln('   This screen demonstrates changing to ',Mode[N],' textmode.');
  142.     pause(5);
  143.   end;
  144.  
  145.  
  146. begin
  147.   PreparePage(First,Off,yellow    ,Magenta );
  148.  
  149.   TextModeDemo(CO80);
  150.   if VideoAdapter <> MDA then
  151.      begin
  152.        TextModeDemo(FONT8X8);
  153.        TextModeDemo(BW40);
  154.        TextModeDemo(BW80);
  155.        TextModeDemo(co40);
  156.        TextModeDemo(co80);
  157.      end;
  158.  
  159.   HighVideo;CLS;
  160.   gotoxy(10,2);
  161.   writeln('...demonstrating ALPHA''s standard CRT unit features:');
  162.   writeln;
  163.  
  164.   GotoXY(1,12);WriteChar('1',80);GotoXY(1,13);WriteChar('2',80);
  165.   GotoXY(1,14);WriteChar('3',80);GotoXY(1,15);WriteChar('4',80);
  166.   GotoXY(1,16);WriteChar('5',80);GotoXY(1,17);WriteChar('6',80);
  167.   GotoXY(1,18);WriteChar('7',80);GotoXY(1,19);WriteChar('8',80);
  168.   GotoXY(1,20);WriteChar('9',80);GotoXY(1,21);WriteChar('0',80);delay(250);
  169.  
  170.   GotoXY(05,5);ClrEol;GotoXY(05,5);
  171.   write('The WHEREX statement shows the X position on the screen.');
  172.   reversecolorxy(9,5,6);cursor(off);gotoxy(33,15);N:=whereX;GotoXY(05,7);
  173.   write('The X position is ',n,'.');gotoxy(33,15);cursor(block);pause(5);
  174.  
  175.   GotoXY(05,5);ClrEol;GotoXY(05,5);
  176.   write('The WhereY statement shows the Y position on the screen.');
  177.   reversecolorxy(9,5,6);cursor(off);gotoxy(33,15);N:=whereY;GotoXY(05,7);
  178.   write('The Y position is ',n,'.');gotoxy(33,15);cursor(block);pause(5);
  179.  
  180.   GotoXY(05,7);ClrEol;
  181.   GotoXY(05,5);ClrEol;
  182.   write('The CLREOL statement will clear to the end of a line.');
  183.   reversecolorxy(9,5,6);gotoxy(33,15);cursor(block);pause(2);
  184.   clrEol;pause(2);
  185.  
  186.   GotoXY(05,5);ClrEol;
  187.   write('The INSLINE statement does a scroll down the screen.');
  188.   reversecolorxy(9,5,7);GotoXY(05,18);;delay(500);
  189.   InsLine;delay(500);InsLine;delay(500);InsLine;pause(2);
  190.  
  191.  
  192.   GotoXY(05,5);ClrEol;
  193.   write('The DELLINE statement does a scroll up the screen.');
  194.   reversecolorxy(9,5,7);GotoXY(05,18);
  195.   delLine;delay(500);delLine;delay(500);delLine;delay(500);
  196.  
  197.   cursor(off);Gotoxy(1,12);Writechar(#32,1500);
  198.  
  199.   GotoXY(05,5);ClrEol;  {TextColor(Yellow);}
  200.   write('Set foreground color with the TEXTCOLOR statement.');
  201.   reversecolorxy(35,5,9);pause(3);
  202.   GotoXY(05,5);TextColor(Yellow);ClrEol;
  203.   write('Set foreground color with the TEXTCOLOR statement.');
  204.   reversecolorxy(35,5,9);pause(3);
  205.  
  206.   gotoxy(5,5);ClrEol;
  207.   Write('Set background color with the TEXTBACKGROUND statement.');
  208.   reversecolorxy(35,5,14);pause(3);
  209.   TextBackground(lightblue);reset;gotoxy(5,5);
  210.   Write('Set background color with the TEXTBACKGROUND statement.');
  211.   reversecolorxy(35,5,14);pause(3);
  212.  
  213.   gotoxy(5,5);ClrEol;
  214.   write('You turn off HIGHVIDEO by using the LOWVIDEO statement.');
  215.   reversecolorxy(41,5,8);pause(3);
  216.   gotoxy(5,5);ClrEol;LowVideo;
  217.   write('You turn off HIGHVIDEO by using the LOWVIDEO statement.');
  218.   reversecolorxy(41,5,8);pause(3);
  219.  
  220.   gotoxy(5,5);ClrEol;
  221.   write('You turn ON 16 Foreground colors by using the HIGHVIDEO statement.');
  222.   reversecolorxy(51,5,9);pause(3);
  223.   HighVideo;reset;gotoxy(5,5);
  224.   write('You turn ON 16 Foreground colors by using the HIGHVIDEO statement.');
  225.   reversecolorxy(51,5,9);pause(3);
  226.  
  227.   gotoxy(5,5);ClrEol;
  228.   write('You can reset starting color by using the NORMVIDEO statement.');
  229.   reversecolorxy(47,5,9);pause(3);
  230.   NormVideo;reset;gotoxy(5,5);
  231.   write('You can reset starting color by using the NORMVIDEO statement.');
  232.   reversecolorxy(47,5,9);pause(3);
  233.  
  234.   SetColor(black,cyan);cls;
  235.   GotoXY(1,05);
  236.   writeln('    In general,  the CRT features  were provided  ONLY so  that ALPHA');
  237.   writeln('    would be fairly compatible with the CRT unit.  Due to the greatly');
  238.   writeln('    enhanced  features  of  ALPHA''s NEW  statements, there  exclusive');
  239.   writeln('    use is highly recommended.');
  240.   writeln;
  241.   writeln('    Above ALL you should avoid using the WRITE statements. While this');
  242.   writeln('    DEMO shows that WRITE  can work with ALPHA, it will actually work');
  243.   writeln('    ONLY under certain circumstances.');
  244.   writeln;
  245.   writeln('    ALPHA provides DISPLAY statements to be used in leu of WRITE. The');
  246.   writeln('    DISPLAY statement  makes writing to  the screen  much more easier');
  247.   writeln('    and direct than using WRITE.');
  248.   writeln;
  249.   writeln('    ALPHA  provides  ECHO statements  to be used in leu of WRITE when');
  250.   writeln('    both  redirection  and  COLOR is required  at the same time. Yes,');
  251.   writeln('    this means  that with ALPHA  you can see everything that is being');
  252.   writeln('    redirected to the printer or a file on screen and in COLOR!');
  253.   pause(30);
  254.   cls;
  255.   GotoXY(01,05);
  256.   writeln('    CRT''s TEXTMODE statement  has been  modified so  that an improper');
  257.   writeln('    MODE value will not lock up any PC.  Hence, a program written for');
  258.   writeln('    a VGA will work on a MONO adapter!');
  259.   writeln;
  260.   writeln('    Likewise,  the CRT statements  TEXTCOLOR  and TEXTBACKGROUND will');
  261.   writeln('    work on a MONO adapter  even though  the program was  written for');
  262.   writeln('    a VGA.');
  263.   pause(20);cls;
  264.  
  265. end;
  266.  
  267.  
  268.  
  269.  
  270. Procedure rainbow;
  271.  
  272. Procedure FirstPage;
  273. var X,Y,x1,Y1:word;
  274. begin
  275.   PreparePage(first,Off,black,black);
  276.   fillpage(shadelight);
  277.   Y1:=MaxRows;
  278.   X1:=MaxCols;
  279.   TextColor(white);
  280.   if VideoAdapter<>MDA then
  281.      begin
  282.         for Y:=1 to Y1 do
  283.           begin
  284.         for X:=1 to X1 do
  285.           begin
  286.             ChangeBackgroundXY(x,y,1,Random(15));
  287.           end;
  288.           end;
  289.      end;
  290.   SetColor(white,blue);
  291.   gotoxy(25,11);WriteChar(space,35);
  292.   display(25,12,' ALPHA lets you write to Video RAM. ');
  293.   gotoxy(25,13);WriteChar(space,35);
  294.   SetColor(white,Black);Display(35,02,' Video Page One ');
  295. end;
  296.  
  297. Procedure SecondPage;
  298. var L,n:byte;
  299. begin
  300.   PreparePage(Second,Off,blue,lightgreen);
  301.   fillpage(shadelight);
  302.   L:=MaxCols;
  303.   for n:=15 downto 0 do ChangeBackgroundXY(1,N+5,L,N);
  304.   SetColor(white,blue);
  305.   gotoxy(20,11);WriteChar(space,45);
  306.   display(20,12,' ALPHA lets you write to hidden video Pages. ');
  307.   gotoxy(20,13);WriteChar(space,45);
  308.   SetColor(white,Black);Display(33,02,' Video Page Two ');
  309. end;
  310.  
  311. Procedure ThirdPage;
  312. var n:byte;
  313. begin
  314.   PreparePage(third,Off,lightBlue,lightred);
  315.   FillPage(CrossWeave);
  316.   setcolor(black,yellow);
  317.   gotoxy(12,11);WriteChar(space,61);
  318.   display(12,12,' You can create multi-Pages that are hidden. Then display    ');
  319.   display(12,13,' them instantaneously to your users. Writing to hidden Pages ');
  320.   display(12,14,' speeds up the apparent of your application.                 ');
  321.   gotoxy(12,15);WriteChar(space,61);
  322.   SetColor(white,Black);Display(32,02,' Video Page Third ');
  323. end;
  324.  
  325. Procedure FourthPage;
  326. var n:byte;
  327. begin
  328.   PreparePage(fourth,Off,lightcyan,lightblue);
  329.   FillPage(Crosshatch);
  330.   setcolor(Green,white);
  331.   gotoxy(7,7);WriteChar(space,60);
  332.   display(7,8,' Most CRT adapters provide four four Pages. But, ALPHA does ');
  333.   display(7,9,' support a maximum of eight pages.  As MONO adapters have   ');
  334.   display(7,10,' only one page, pages should be written in sequence so that ');
  335.   display(7,11,' ALPHA can transparently display them one at a time.        ');
  336.   gotoxy(7,12);WriteChar(space,60);
  337.   SetColor(white,Black);Display(32,02,' Video Page Four ');
  338. end;
  339.  
  340. begin
  341.   PreparePage(second,off,white,black);
  342.   fillpage(shadelight);
  343.   Display(23,10,' ... ALPHA will now do some video magic: ');
  344.   SetActivePage(second);if VideoAdapter=MDA then Pause(2);
  345.  
  346.   FirstPage;pause(2);
  347.   SetActivePage(first);
  348.   secondpage; if VideoAdapter=MDA then Pause(2);
  349.   thirdPage; if VideoAdapter=MDA then Pause(2);
  350.   fourthpage; if VideoAdapter=MDA then Pause(2);
  351.   pause(1);
  352.   SetActivePage(second);pause(2);
  353.   SetActivePage(third);pause(2);
  354.   SetActivePage(fourth);pause(5);
  355.   for N:=1 to 10 do
  356.     begin
  357.       SetActivePage(Pages(Random(3)));
  358.       delay(300)
  359.     end;
  360.   for N:=1 to 10 do
  361.     begin
  362.       SetActivePage(Pages(Random(3)));
  363.       delay(200)
  364.     end;
  365.   for N:=1 to 15 do
  366.     begin
  367.       SetActivePage(Pages(Random(3)));
  368.       delay(130)
  369.     end;
  370.   for N:=1 to 20 do
  371.     begin
  372.       SetActivePage(Pages(Random(3)));
  373.       delay(090)
  374.     end;
  375.   setActivePage(third);pause(5);
  376. end;
  377.  
  378.  
  379.  
  380.  
  381.  
  382. Procedure AddedFunctionsDemo;
  383. begin
  384.   HighVideo;
  385.   SetColor(yellow,blue);cls;
  386.   CLS;
  387.   gotoxy(10,2);
  388.   writeln('...demonstrating a few of ALPHA''s added features:');
  389.   PAUSE(2);
  390.  
  391.   display(5,5,'Use Cursor(ON) to turn the cursor ON.');
  392.   N:=whereX;reversecolorxy(9,5,10);GotoX(N);;CURSOR(on);pause(3);
  393.  
  394.   Home;ClrEol;
  395.   Display(5,5,'Use Cursor(BLOCK) to turn the BLOCK cursor on.');
  396.   N:=whereX;reversecolorxy(9,5,13);GotoX(N);CURSOR(BLOCK);pause(3);
  397.  
  398.   Home;ClrEol;
  399.   Display(5,5,'Use Cursor(OFF) to turn the cursor OFF.');
  400.   N:=whereX;reversecolorxy(9,5,11);GotoX(N);CURSOR(off);pause(3);
  401.  
  402.   GotoXY(05,5);ClrEol;GotoXY(05,5);
  403.   write('Use ReverseColorXY(9,5,22) to reverse the color of this line.');
  404.   reversecolorXY(9,5,22);pause(3);
  405.  
  406.   Home;ClrEol;
  407.   Display(5,5,'Use Display to write to the screen.');
  408.   N:=whereX;reversecolorxy(9,5,7);GotoX(N);CURSOR(off);pause(3);
  409.  
  410.   Home;ClrEol;
  411.   Display(5,5,'Use CLS to clear the screen or any Video Page with spaces.');
  412.   N:=whereX;reversecolorxy(9,5,3);GotoX(N);CURSOR(off);pause(3);
  413.   Display(5,7,'But use FillPage to fill a screen or Video Page with any Character.');
  414.   N:=whereX;reversecolorxy(13,7,8);GotoX(N);CURSOR(off);pause(3);
  415.   Home;ClrEol;
  416.  
  417.   GotoXY(05,5);ClrEol;
  418.   Display(5,5,'Use SetBorder to change the border color.');
  419.   N:=whereX;reversecolorxy(9,5,9);GotoX(N);CURSOR(off);pause(3);
  420.   for n:=1 to 30 do begin setborder(random(16));delay(300);end;
  421.   pause(3);setborder(black);
  422.  
  423.   Home;ClrEol;
  424.   Display(5,5,'Use SetPage to Display to a hidden Video Page.');
  425.   N:=whereX;reversecolorxy(9,5,7);GotoX(N);CURSOR(off);pause(3);
  426.   Display(5,7,'But use SetActivePage to Display a hidden Page to the screen.');
  427.   N:=whereX;reversecolorxy(13,7,13);GotoX(N);CURSOR(off);pause(3);
  428.   Home;ClrEol;
  429.  
  430.   Home;ClrEol;
  431.   Display(5,5,'Use SetColor to change both Foreground/Background Color.');
  432.   N:=whereX;reversecolorxy(9,5,8);GotoX(N);CURSOR(off);pause(3);
  433.  
  434.   Home;ClrEol;
  435.   Display(5,5,'Use ChangeColorXY to change the color of text at a position on the screen.');
  436.   N:=whereX;reversecolorxy(9,5,13);GotoX(N);CURSOR(off);pause(3);
  437.   Home;ClrEol;
  438.  
  439.   Home;ClrEol;
  440.   Display(5,5,'Use Int2Str to Display whole numbers on screen.');
  441.   N:=whereX;reversecolorxy(9,5,7);GotoX(N);CURSOR(off);pause(3);
  442.   Display(5,7,'But use Real2Str display Real numbers on screen.');
  443.   N:=whereX;reversecolorxy(13,7,8);GotoX(N);CURSOR(off);pause(3);
  444.   Home;ClrEol;
  445.  
  446.   rainbow;
  447. end;
  448.  
  449.  
  450. begin
  451.   StartUp;             beep;
  452.   CursorDemo;          beep;
  453.   CrtFeatures;         beep;
  454.   AddedFunctionsDemo;  beep;
  455. end.
  456.